home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / pvm34b3.zip / pvm34b3 / pvm3 / examples / spmd.f < prev    next >
Text File  |  1997-07-22  |  3KB  |  95 lines
  1. c
  2. c $Id: spmd.f,v 1.3 1997/06/26 21:31:15 pvmsrc Exp $
  3. c
  4. c---------------------------------------- 
  5. c   SPMD Fortran example using PVM 3
  6. c   Illustrates use of new pvm3.4 call pvmfsiblings
  7. c---------------------------------------- 
  8.        program spmd
  9.        include '../include/fpvm3.h'
  10.        PARAMETER( MAXNPROC=32 )
  11.  
  12.        integer mytid, me, info
  13.        integer tids(0:MAXNPROC -1)
  14.        integer ntids 
  15.  
  16. c      -------------
  17. c      Enroll in pvm
  18. c      -------------
  19.        call pvmfmytid( mytid )
  20.  
  21. c      --------------------------------------------
  22. c      Call pvmfsiblings to determine how many tasks were 
  23. c      spawned with me. 
  24. c      --------------------------------------------
  25.        me = -1 
  26.        call pvmfsiblings(ntids, 0, tids(0))
  27.        if (ntids .gt. MAXNPROC) ntids = MAXNPROC
  28.      
  29.        do i = 0, ntids - 1
  30.            call pvmfsiblings(ntids, i, tids(i))
  31.            if (tids(i) .eq. mytid) me = i
  32.        end do
  33.     
  34.  
  35.        if (me .eq. -1) then
  36.            call pvmfexit()
  37.            stop
  38.        endif
  39.       
  40.        if (me .eq. 0) then
  41.           write (6,*) 'Pass a token through the', ntids, ' tid ring:'
  42.           write (6,6000) (tids(i), i=0, ntids-1), tids(0)
  43.  6000     format( 6(I7:, ' -> '))
  44.        end if
  45.         
  46.        call dowork( me, ntids )
  47.  
  48. c      -------------------------
  49. c      program finished exit pvm
  50. c      -------------------------
  51.        call pvmfexit(info)
  52.        stop
  53.        end
  54.  
  55.  
  56.        subroutine dowork( me, nproc )
  57.        include '../include/fpvm3.h'
  58. c-------------------------------------------------
  59. c Simple subroutine to pass a token around a ring
  60. c-------------------------------------------------
  61.        integer me, nproc
  62.  
  63.        integer token, src, dest, count, stride, msgtag 
  64.        integer ndum
  65. c      -------------------------------
  66. c      Determine neighbors in the ring
  67. c      -------------------------------
  68.        call pvmfsiblings(ndum, me-1, src )
  69.        call pvmfsiblings(ndum, me+1, dest )
  70.        if( me .eq. 0 ) call pvmfsiblings( ndum, nproc-1, src )
  71.        if( me .eq. nproc - 1 ) call pvmfsiblings( ndum, 0, dest)
  72.  
  73.        count  = 1
  74.        stride = 1
  75.        msgtag = 4
  76.  
  77.  
  78.        if( me .eq. 0 ) then
  79.           token = dest
  80.           call pvmfinitsend( PVMDEFAULT, info )
  81.           call pvmfpack( INTEGER4, token, count, stride, info )
  82.           call pvmfsend( dest, msgtag, info )
  83.           call pvmfrecv( src, msgtag, info )
  84.           print*, 'token ring done'
  85.        else
  86.           call pvmfrecv( src, msgtag, info )
  87.           call pvmfunpack( INTEGER4, token, count, stride, info )
  88.           call pvmfinitsend( PVMDEFAULT, info )
  89.           call pvmfpack( INTEGER4, token, count, stride, info )
  90.           call pvmfsend( dest, msgtag, info )
  91.        endif
  92.       
  93.        return
  94.        end
  95.